\ The Rest is Silence 30Jun86gem************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** *** modified for Atari ST by: George Morison *** *** 70745,1411 CompuServe *** ************************************************************* ************************************************************* ( Load Screen to Bring up Standard System 03Jul86gem) CR .( Loading system extensions.) CR 2 VIEW# ! ( This will be view file# 2 ) WARNING OFF 3 LOAD ( BASICS ) 6 LOAD ( FILE-INTERFACE ) FROM TRAPS.BLK 1 LOAD ( Atari ST functions ) FROM CPU68000.BLK 1 LOAD ( Assembler ) FROM UTILITY.BLK 1 LOAD ( Utilities ) \ FROM ZEDIT.BLK 1 LOAD ( Full screen editor ) WARNING ON --> \ Load up the system 26Jun86gem: HELLO (S -- ) cr ." 68000 Forth 83 Model, Atari ST " cr ." Version 2.1.0 Modified 04Jul86 " [ EDITOR ] SET-ID WRAP START ONLY FORTH ALSO DEFINITIONS ; ' HELLO IS BOOT \ 13 LOAD ( Configuration: change and load as desired. ) : MARK (S -- ) CREATE DOES> (FORGET) FORTH DEFINITIONS ; MARK EMPTY HERE FENCE ! CR .( System has been loaded, Size = ) HERE U. SAVE-SYSTEM F83.TOS cr .( System saved as F83.TOS ) ( Commenting and Loading Words 16Oct83map) 64 CONSTANT C/L 16 CONSTANT L/SCR : \ ( -- ) >IN @ NEGATE C/L MOD >IN +! ; IMMEDIATE : (S ( -- ) [COMPILE] ( ; IMMEDIATE : ? (S adr -- ) @ . ; : ?ENOUGH (S n -- ) DEPTH 1- > ABORT" Not enough Parameters" ; : THRU (S n1 n2 -- ) 2 ?ENOUGH 1+ SWAP ?DO I LOAD LOOP ; : +THRU (S n1 n2 -- ) BLK @ + SWAP BLK @ + SWAP THRU ; : --> (S -- ) >IN OFF 1 BLK +! ; IMMEDIATE 1 2 +THRU ( Rest of Basic Utilities ) \ The ALSO and ONLY Concept 07Feb84mapCONTEXT DUP @ SWAP 2+ ! ( Make FORTH also ) VOCABULARY ROOT ROOT DEFINITIONS : ALSO (S -- ) CONTEXT DUP 2+ #VOCS 2- 2* CMOVE> ; : ONLY (S -- ) ['] ROOT >BODY CONTEXT #VOCS 1- 2* 2DUP ERASE + ! ROOT ; : SEAL (S -- ) ' >BODY CONTEXT #VOCS 2* ERASE CONTEXT ! ; : PREVIOUS (S -- ) CONTEXT DUP 2+ SWAP #VOCS 2- 2* CMOVE CONTEXT #VOCS 2- 2* + OFF ; \ The ALSO and ONLY Concept 28AUG83HHL: FORTH FORTH ; : DEFINITIONS DEFINITIONS ; : ORDER (S -- ) CR ." Context: " CONTEXT #VOCS 0 DO DUP @ ?DUP IF BODY> >NAME .ID THEN 2+ LOOP DROP CR ." Current: " CURRENT @ BODY> >NAME .ID ; : VOCS (S -- ) VOC-LINK @ BEGIN DUP #THREADS 2* - BODY> >NAME .ID @ DUP 0= UNTIL DROP ; ONLY FORTH ALSO DEFINITIONS \ Load Screen for DOS Interface 22Jun86gemDOS DEFINITIONS 1 6 +THRU FORTH DEFINITIONS CR .( File Interface Loaded ) \S The DOS interface consists of a set of words that access the TRAP functions of DOS, such as making, opening, and deleting files. There is also a word that parses a string and creates a file control block. Finally the word SAVE can be used to save the contents of memory as a DOS file. \ DOS Interface 26Jun86gemCREATE FCB2 B/FCB ALLOT hex : CLOSE (S fcb -- ) handle# @ 3E trap#1 2swap 2drop drop DOS-ERR? ABORT" Close error" ; : SEARCH0 (S attr fcb -- n ) bank 4E trap#1 drop >r 2drop 2drop r> ; : SEARCH (S fcb -- n ) drop 4F trap#1 rot 2drop ; : DELETE (S fcb -- ) bank 41 trap#1 drop >r 2drop drop r> ; \ DOS-ERR? ABORT" Delete error" ; : MAKE-FILE (S attr fcb -- ) dup -rot bank 3C trap#1 drop dup DOS-ERR? if ABORT" Can't MAKE File " then >r 2drop 2drop r> swap handle# ! ; : SELECT (S drive -- ) 0E trap#1 2drop 2drop ; decimal \ Create File Control Blocks 23Jun86gemhex : read (S daddr dlen fcb -- ) handle# @ 3F trap#1 2drop 2drop 2drop 2drop ; : write (S daddr dlen fcb -- ) handle# @ 40 trap#1 2drop 2drop 2drop 2drop ; decimal : (!FCB) (S Addr len FCB-addr -- ) dup b/fcb erase swap move ; : !FCB (S FCB-addr ) BL WORD COUNT CAPS @ IF 2DUP UPPER THEN ROT (!FCB) ; \ Save a Core Image as a File on Disk 26Jun86gemDEFER HEADER HEX : 68K-HEADER (S addr len -- addr-62 len+62 ) 3E + SWAP 3E - SWAP OVER DUP 1C ERASE 601A OVER ! 4 + HERE OVER ! 14 + 500 OVER ! 2+ ON HERE 500 1A - ! ; ' 68K-HEADER IS HEADER DECIMAL : SAVE (S Addr len --- ) FCB2 DUP !FCB DELETE DROP 0 FCB2 MAKE-FILE HEADER bank SWAP 0 FCB2 WRITE FCB2 CLOSE ; FORTH DEFINITIONS : MORE (S n -- ) [ DOS ] 1 ?ENOUGH CAPACITY SWAP DUP FILE @ MAXREC# +! BOUNDS ?DO I BLOCK ( BUFFER ) B/BUF BLANK UPDATE LOOP SAVE-BUFFERS EMPTY-BUFFERS FILE @ CLOSE ; : CREATE-FILE (S #blocks -- ) [ DOS ] FCB2 DUP !FILES DUP !FCB 0 SWAP MAKE-FILE MORE ; \ Display Directory 26Jun86gemDOS DEFINITIONS : .NAME (S n -- ) #OUT @ C/L > IF CR THEN DOS-ERR? NOT IF DMA 30 + 13 TYPE 3 SPACES THEN ; FORTH DEFINITIONS : DIR (S -- ) [ DOS ] " ????????.???" FCB2 (!FCB) CR DMA CLR-DMA DMA bank SET-DMA 0 FCB2 SEARCH0 BEGIN .NAME DMA 21 + 23 BLANK DMA bank SET-DMA FCB2 SEARCH DUP DOS-ERR? UNTIL DROP ; : DRIVE? (S -- ) 25 TRAP#1 DROP NIP ASCII A + EMIT ." : " ; : A: (S -- ) [ DOS ] 0 SELECT ; : B: (S -- ) [ DOS ] 1 SELECT ; DOS DEFINITIONS \ Define and Open files 25Jun86gem: FILE: (S -- fcb ) >IN @ CREATE >IN ! HERE DUP B/FCB ALLOT !FCB DOES> !FILES ; : ?DEFINE (S -- fcb ) >IN @ DEFINED IF NIP >BODY ELSE DROP >IN ! FILE: THEN ; FORTH DEFINITIONS : DEFINE (S -- ) [ DOS ] ?DEFINE DROP ; : OPEN (S -- ) [ DOS ] EMPTY-BUFFERS \ IN-FILE @ CLOSE ?DEFINE !FILES OPEN-FILE ; : FROM (S -- ) [ DOS ] EMPTY-BUFFERS \ IN-FILE @ CLOSE ?DEFINE IN-FILE ! OPEN-FILE ; : SAVE-SYSTEM (S -- ) [ DOS HEX ] 500 HERE SAVE ; DECIMAL \ Viewing Source Screens 03Jul86gemCREATE VIEW-FILES 32 ALLOT VIEW-FILES 32 ERASE : VIEWS (S n -- ) [ DOS ] ?DEFINE 2DUP 40 + ! BODY> SWAP 2* VIEW-FILES + ! ; 1 VIEWS KERNEL.BLK 2 VIEWS EXTEND.BLK 3 VIEWS TRAPS.BLK 4 VIEWS CPU68000.BLK 5 VIEWS UTILITY.BLK \ 6 VIEWS ZEDIT.BLK \ My normal configuration 07Apr84mapCAPS ON ' EPSON IS INIT-PR ' FORM-FEED IS PAGE ' (WHERE) IS WHERE EDITOR QUME FORTH 5 VIEWS CLOCK.BLK FROM CLOCK.BLK 1 LOAD ( Load Screen to Bring up Standard System 25Jun86gem) This is set so that definitions in this file can be VIEWed. BASICS are needed by everything else. FILE-INTERFACE allows convenient use of files. CPU68000.BLK Contains all of the 68000 machine dependent stuff such as the Assembler, the Debug Utility which patches NEXT, and the MultiTasker, which needs some code words in order to function efficiently. UTILITY.BLK Contains all of the standard utilities that are usually resident in a Forth system, such as the editor, the decompiler, a print utility, etc. \ Load up the system 07Apr84mapHELLO (S -- ) Gives the user the sign on message, making him foolishly believe that he is running an 83 Standard System. It also does all of the one time start up code required, such as relocating the heads and opening the screen file, if any. Load configuration. Personalize here. MARK (S -- ) A Defining word that allows you to restore the dictionary to a known state. EMPTY The current state of the dictionary. ( Commenting and Loading Words 25Jul83map) C/L The number of characters per line. L/SCR The number of lines per screen. \ A comment word. Ignores the rest of the line (S Used for Stack Comments. Behaves just like ( ? Displays the contents of an address. ?ENOUGH (S n -- ) Issue an error message if too few parameters on the stack. THRU (S n1 n2 -- ) Load a bunch of screens. +THRU (S n1 n2 -- ) Load a bunch of screens relative to the current screen. --> (S -- ) Load the next screen. \ The ALSO and ONLY Concept 03Apr84map ROOT A small vocabulary for controlling search order. ALSO (S -- ) Adds another vocabulary to the search order. ONLY Erases the search order and forces the ROOT vocabulary to be the first and last. SEAL Usage: SEAL FORTH will change the search order such that only FORTH will be searched. Used for turn-key applications. PREVIOUS The inverse of ALSO, removes the most recently referenced vocabulary from the search order. \ The ALSO and ONLY Concept 03Apr84mapWe initialize the ROOT vocabulary with a few definitions that allow us to do vocabulary related things. ORDER (S -- ) Displays the search order currently in effect. Also displays the CURRENT vocabulary, which is were definitions are placed. VOCS (S -- ) Lists all of the vocabularies that have been defined so far, in the order of their definition. \ DOS BDOS Interface 10Apr84mapFCB2 Space for a second FCB when needed. RESET Reset the DOS disk system CLOSE Close the given file, and report errors. SEARCH0 Search for the first occurance SEARCH Search for the next occurance. DELETE Remove an old file. READ Read the next sequential record, and report errors. WRITE Write the next sequential record, and report errors. MAKE-FILE create a directory entry for a new file, and report errors. \ Create File Control Blocks 11Apr84map(!FCB) (S Addr len FCB-addr --- ) Set up the filce control block per the specified string. This is the primitive file parse word, which breaks the drive/file name string into a drive specifier, file name, and extension, and leaves the parsed result in the given file control block address. !FCB (S FCB-addr ) Parse the next word in the input stream as a file. If CAPS is false, allow lower case names. SELECT make given drive the default. \ Save a Core Image as a File on Disk 22FEB84MAPHEADER This is different for CP/M-80, CP/M-86, and CP/M-68K. SAVE (S addr len -- ) Save the string specified as a CP/M file whose name is specified following the SAVE word. The current screen file is not disturbed. MORE Extend the size of the current file by n Blocks. CREATE-FILE creates a new file containing the given number of blocks. \ Display Directory 30Jun86gem .NAME prints one filename. DIR prints a normal directory of the current drive. DRIVE? prints currently selected drive. A: selects drive A as the default. B: selects drive B as the default. \ Open files and list directories 29Mar84mapFILE: (S -- fcb ) Define the next word as a file by allocating an FCB in the dictionary and parsing the next word as a file name. Leave the address of the file control block. ?DEFINE (S -- fcb ) Define the next word as a file if it does not already exist. Leave the address of the file control block. DEFINE (S -- ) Define the following word as a file name without opening it. OPEN (S -- ) Open the following file and make it the current file. FROM (S -- ) Open the following file and make it the current input file. SAVE-SYSTEM (S -- ) Usage: SAVE-SYSTEM NEWNAME.68K Saves an executable image of the system as a file. \ Set up VIEW-FILES table 30Jun86gemVIEW-FILES is an array of pointers to fcbs. VIEWS installs a file into the VIEW-FILES array, and sets the fcb to contain the matching view number. Now initialize the VIEW-FILES array: KERNEL.BLK was used to generate the precompile code. EXTEND.BLK was opened on the execute line, loads all extras. CPU68000.BLK has the machine dependent post-compile code. UTILITY.BLK has the machine independent post-compile code.
